home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / td.arc / TD.LIB < prev    next >
Encoding:
Text File  |  1985-07-03  |  4.4 KB  |  152 lines
  1.  
  2. { Turbodraw library }
  3.  
  4. type
  5.     stype = string[20];
  6.  
  7. const
  8.     ctlh = ^H;   { Backspace }
  9.     ctlm = ^M;   {  Return   }
  10.  
  11.  
  12. function getnum(p,q:integer):stype;    { 12/19/84 }
  13.  
  14. { Getnum allows entry of a number of Scale P and Precision Q }
  15. { The operator is not allowed to enter a number with greater }
  16. { precision and/or scale.  Character delete using the back-  }
  17. { space key can be used.                                     }
  18.  
  19. var
  20.     i      : integer;
  21.     number : stype;       { Input buffer }
  22.     digit  : char;
  23.     frac   : integer;
  24.     dp     : boolean;
  25.  
  26. begin
  27.     I:=1;
  28.     Dp:=false;
  29.     Frac:=0;
  30.     Digit:=' ';
  31.     Number:=' ';
  32.  
  33.     while Digit <> ctlm do
  34.         begin          { don't exit until a CR is entered }
  35.         read(kbd,digit);
  36.         write(digit);
  37.         If Digit=ctlh Then { backspace }
  38.             If I > 1 Then
  39.                 begin
  40.                 I:=I-1;
  41.                 If Dp=TRUE Then Frac:=Frac-1;
  42.                 If Copy(Number,I,1)='.' Then
  43.                     begin     { special handling for decimal point }
  44.                     Dp:=FALSE;
  45.                     Frac:=0   { just to make sure its at zero    }
  46.                 End;
  47.                 number:=copy(number,1,i-1)+' '+copy(number,i+1,20);
  48.                 write(' ' + ctlh)     { Delete character on screen }
  49.             End
  50.             Else { If I>1 }
  51.                 write(' ');  { put cursor back }
  52.             If Digit='-' Then
  53.                 If I = 1 Then
  54.                     begin
  55.                     number:=copy(number,1,i-1)+digit+copy(number,i+1,20);
  56.                     I:=I+1;
  57.                 End
  58.                 Else
  59.                     Digit:=' ';
  60.             if digit in ['0'..'9'] then
  61.                 begin;
  62.                 If Dp=TRUE Then { we are past decimal point    }
  63.                     begin
  64.                     if (I=P+2) or (Frac = q) Then
  65.                         write(ctlh + ' ' + ctlh)  { At full prec. }
  66.                     Else
  67.                         begin
  68.                         number:=copy(number,1,i-1)+digit+copy(number,i+1,20);
  69.                         Frac:=Frac+1;
  70.                         I:=I+1;
  71.                     End
  72.                 End
  73.                 Else    { If DP }
  74.                 If I=P-Q+1 Then   { allow only a '.' }
  75.                     write(ctlh + ' ' + ctlh)
  76.                 Else
  77.                     begin
  78.                     number:=copy(number,1,i-1)+digit+copy(number,i+1,20);
  79.                     I:=I+1;
  80.                 End;
  81.  
  82.             End    { If verify }
  83.             Else
  84.             If Digit='.' Then
  85.                 If Dp=FALSE Then { only one decimal per number }
  86.                     begin
  87.                     number:=copy(number,1,i-1)+'.'+copy(number,i+1,20);
  88.                     I:=I+1;
  89.                     Dp:=TRUE;
  90.                 End
  91.                 Else
  92.                 Digit:=' ';  { eliminate extra decimal point }
  93.                 if not (digit in ['-','0'..'9','.',ctlh,ctlm]) then
  94.                     write(ctlh + ' ' + ctlh);
  95.             End;  { Do While }
  96.  
  97.            getnum:=number;
  98.        end;
  99.  
  100. function getreal(len,scale : integer) : real;
  101.  
  102. { GETREAL returns a number of max length LEN }
  103. { and max scale SCALE                        }
  104.  
  105. var
  106.    i,j,temp,sign  : integer;
  107.    result         : real;
  108.    digit          : char;
  109.    num            : stype;
  110.    code           : integer;
  111.  
  112. begin
  113.    num:=getnum(len,scale);
  114.    i:=length(num);
  115.    j:=1;
  116.    sign:=1;
  117.    while i > 0 do
  118.        begin
  119.        digit:=copy(num,i,1);
  120.        i:=i-1;
  121.        case digit of
  122.            '0'..'9' : begin
  123.                          val(digit,temp,code);
  124.                          result:=result+(temp*j);
  125.                          j:=j*10;
  126.                       end;
  127.            '-'      : sign:=-1;
  128.            '.'      : begin
  129.                          result:=result/j;
  130.                          j:=1;
  131.                       end;
  132.         end;
  133.     end;
  134.     getreal:=result*sign;
  135. end;
  136.  
  137. function getint(len : integer) : integer;
  138.  
  139. { GETINT returns a number of max length LEN and }
  140. { a scale of zero ( integer )                   }
  141.  
  142. var
  143.    result,code : integer;
  144.    num         : stype;
  145.  
  146. begin
  147.    val(getnum(len,0),result,code);
  148.    getint:=result;
  149. end;   { of Turbodraw Library }
  150.  
  151.  
  152.